home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
RTPC10
/
DJDUMP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-11-20
|
5KB
|
105 lines
{
┌────────┬──────────────────────────────────────────────────────┐
│Name │ DJDUMP.PAS │
├────────┼──────────────────────────────────────────────────────┤
│Use │ Just an example procedure for TP6 and above. │
│ │ Dumps a 640x480x16 VGA screen to the HP DeskJet on │
│ │ LPT1 in 16 gray scales. │
├────────┼──────────────────────────────────────────────────────┤
│By │ Rafe Aldridge - (C) Copyright 1993 │
└────────┴──────────────────────────────────────────────────────┘
┌───────────────────────────────────────────────────────────────┐
│ Please realise that this program present's an idea. No claim │
│ is made that it is well written or cannot be improved upon │
└───────────────────────────────────────────────────────────────┘
┌───────────────────────────────────────────────────────────────┐
│ Rafe's TP Collection is SHAREWARE │
├───────────────────────────────────────────────────────────────┤
│ │
│ If you find any part of Rafe's TP Collection usefull then │
│ please become a registered user by sending 10 Pounds Sterling │
│ to the address below. In return you will recieve the LATEST │
│ FULL source code to ALL the units as well anything new. │
│ │
│ Please feel free to write with suggestions, ideas or money to │
│ Rafe Aldridge, │
│ Street Farm, │
│ Dereham Road, │
│ Garvestone, │
│ Norfolk. │
│ NR9 4QT │
│ ENGLAND │
│ │
└───────────────────────────────────────────────────────────────┘
}
uses printer;
Procedure DJDUMP;
Const
grayscale : array [0..15,0..3] of byte = ((00,00,00,00),
(00,02,00,00),
(00,08,00,02),
(00,10,00,02),
(05,00,05,00),
(05,02,05,00),
(05,08,05,02),
(05,10,05,02),
(10,05,10,05),
(10,07,10,05),
(10,13,10,07),
(10,16,10,07),
(16,05,16,05),
(16,07,16,05),
(16,13,16,07),
(16,16,16,07));
maxx : word = 639;
maxy : word = 239; { half of max.y pixels }
graph_start : string = #27'E'#27'&l0O'#27'*t300R'#27'*r2Q';
graph_finish : string = #27'*rbC0C'#27'E';
graph_init : string = #27'*b240W';
graph_end : string = #27'*rbC';
Var
x,y : word;
a : array [0..3] of string;
s,g,p1,p2 : byte;
function pix (px,py : word) : byte; assembler; { get pixel from screen }
asm
mov ax,0D00h
mov bx,0
mov cx,px
mov dx,py
int 10h
end;
Begin
write (lst,graph_start); { reset printer, open graphics }
for s:=0 to 3 do a[s][0]:=chr(240);
for x:=0 to maxx do { x axis loop }
begin
for y:=maxy downto 0 do { y axis loop }
begin
p1:=pix(x,(y*2)+1);
p2:=pix(x,(y*2));
for s:=0 to 3 do
begin
g:=0;
g:=grayscale [p1,s];
g:=g shl 4;
g:=g OR grayscale [p1,s];
a[s][y+1]:=chr(g);
end; { first s loop }
for s:=0 to 3 do
begin
write (lst,graph_init);
write (lst,a[s]);
write (lst,graph_end);
end; { second s loop }
end; { y loop }
end; { x loop }
write (lst,graph_finish); { close down graphics, reset printer }
end;